home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LISTS / READBP / READBPA.PAS < prev   
Pascal/Delphi Source File  |  1994-11-20  |  15KB  |  424 lines

  1. program ReadBPA;
  2. {Reads Borland BPA Library List File}
  3. {see file ReadBPA.Doc for description and instructions}
  4.  
  5. uses
  6.   crt, dos;
  7.  
  8. {---------------------------------------------------------------------------}
  9. {file name, value assigned by GetFileName}
  10. const
  11.   FileName   : string = 'startup';
  12.  
  13. {---------------------------------------------------------------------------}
  14. {the dynamic array of text from the file,
  15.  allocated and filled by ReadBPAFile
  16.  then used throughout the program}
  17. type
  18.   BPALine    = string[77];
  19. const
  20.   MaxLines   = 7000;
  21. var
  22.   BPA        : array[1..MaxLines] of ^BPALine;
  23.   LineCount  : word;
  24.   LineIndex  : word;
  25.  
  26. {---------------------------------------------------------------------------}
  27. {redefined extended key codes, as returned by KeyReady}
  28. const
  29.   F1 = 128+59;  F2 = 128+60;  F3 = 128+61; F4 = 128+62;  F5 = 128+63;
  30.   F6 = 128+64;  F7 = 128+65;  F8 = 128+66; F9 = 128+67;  F10= 128+68;
  31.   UpArw = 128+72;  DnArw = 128+80;  LfArw = 128+75;  RtArw = 128+77;
  32.   HomKy = 128+71;  EndKy = 128+79;  PgUp  = 128+73;  PgDn  = 128+81;
  33.   AltX  = 128+45;
  34.   Esc= 27;  CR = 13;  Bsp= 8;       {with a few conventional keys sneaked in}
  35. var
  36.   InKey      : word;
  37.  
  38. {---------------------------------------------------------------------------}
  39. {general variables}
  40. const
  41.   ExitFlag   : boolean    = False;
  42.   SearchType : byte       = 0;
  43.   SearchSpec : String[12] = '';
  44.  
  45. {--------------------------------------------------------------------------}
  46. {file reading procedures}
  47.  
  48. procedure ShowDirList(FileSpec:string);           {list the files available}
  49.   var DirInfo: SearchRec;
  50.   begin                                           {this is the demo program}
  51.     FindFirst(FileSpec, Archive, DirInfo);        {from the BP7 help screen}
  52.     while DosError = 0 do                          {for FindFirst, FindNext}
  53.       begin                                       {converted to a procedure}
  54.         gotoxy(9,WhereY);
  55.         writeln(DirInfo.Name);
  56.         FindNext(DirInfo);
  57.       end;
  58.   end;  {ShowDirList}
  59.  
  60. procedure GetFileName(var FileName:string);
  61.   var y : byte;
  62.   begin
  63.     if (filename='startup') and (ParamCount>0) then {command line parameter}
  64.       FileName:=ParamStr(1)
  65.     else
  66.       begin                                 {else get one from the operator}
  67.         window(2,3,79,23); clrscr; writeln;
  68.         ShowDirList('BPA*.*');
  69.         writeln;
  70.         writeln('FileName?');
  71.         writeln('(1 or 2 digit number will read BPAxx.CAT)');
  72.         gotoxy(12,wherey-2);
  73.         readln(FileName);
  74.       end;
  75.                                              {expand the filename as needed}
  76.     case length(FileName) of
  77.       0 : ;
  78.       1 : FileName:= 'BPA0'+FileName+'.CAT';
  79.       2 : FileName:= 'BPA' +FileName+'.CAT';
  80.     else  if pos('.',FileName) = 0 then FileName:= FileName+'.CAT';
  81.     end;
  82.   end;  {GetFileName}
  83.  
  84. {$I-}
  85. function FileExist(FileName: String) : Boolean;
  86.   var  ChkFil : text;
  87.   begin
  88.     if FileName='' then FileExist:=False
  89.     else
  90.       begin
  91.         Assign(ChkFil,FileName);
  92.         Reset(ChkFil);
  93.         Close(ChkFil);
  94.         FileExist:=(IOResult = 0);
  95.       end;
  96.   end;  {FileExist}
  97. {$I+}
  98.  
  99. {I-}
  100. procedure ReadBPAFile(FileName:string);
  101.   var
  102.     i       : word;
  103.     IsBPA   : boolean;
  104.     BPAFile : text;
  105.     FDat    : string[77];
  106.   procedure ReadError(ErrNum:byte);
  107.     const
  108.       ErrMsg : array[1..5] of string[36]
  109.              =('Unable to open file',
  110.                'Error reading file',
  111.                'Too many lines, entire file not read',
  112.                'Out of memory, entire file not read',
  113.                'No BPA Records found');
  114.     var
  115.       ch     : char;
  116.     begin
  117.       writeln; writeln; writeln;
  118.       writeln(FileName);                                     {show filename}
  119.       writeln(ErrMsg[ErrNum]);                                  {show error}
  120.       writeln('Esc to halt, any other key to continue...');         {prompt}
  121.       ch:=readkey;                                                     {wait}
  122.       if ord(ch)=Esc then halt else if ch=#0 then ch:=readkey;
  123.     end;  {ReadError}
  124.  
  125.   begin
  126.     if not FileExist(FileName) then                      {if file not found}
  127.       begin
  128.         ReadError(1);                                       {alert operator}
  129.         LineCount:=0;
  130.         exit;                                                     {and halt}
  131.       end;
  132.     for i:=LineCount downto 1 do Dispose(BPA[i]);              {free memory}
  133.     LineCount:= 0; IsBPA:=False;                         {initialize counts}
  134.     Assign(BPAFile,FileName);
  135.     Reset(BPAFile);                                          {open the file}
  136.     while (not Eof(BPAFile)) do
  137.       begin
  138.         if LineCount = MaxLines then              {this should never happen}
  139.           begin
  140.             ReadError(3);
  141.             break;                        {show that portion which was read}
  142.           end;
  143.         if MaxAvail < SizeOf(BPALine)+8 then              {if out of memory}
  144.           begin
  145.             ReadError(4);
  146.             break;                        {show that portion which was read}
  147.           end;
  148.         readln(BPAFile,FDat);                        {read one line of data}
  149.         if IOResult<> 0 then                            {if file is damaged}
  150.           begin
  151.             ReadError(2);
  152.             for i:=LineCount downto 1 do Dispose(BPA[i]);      {free memory}
  153.             LineCount:=0;
  154.             break;                                     {don't try to use it}
  155.           end;
  156.                                                          {BUT, if no errors}
  157.         inc(LineCount);
  158.         New(BPA[LineCount]);                               {allocate memory}
  159.         BPA[LineCount]^:=FDat;              {and add this line to the array}
  160.         if FDat[1]='[' then IsBPA:=True;
  161.       end;
  162.     Close(BPAFile);
  163.     if not IsBPA then                        {if we didn't find any records}
  164.       begin
  165.         ReadError(5);
  166.         for i:=LineCount downto 1 do Dispose(BPA[i]);          {free memory}
  167.         LineCount:=0;                                  {report no file read}
  168.       end;
  169.   end;  {ReadBPAFile}
  170. {I+}
  171.  
  172. {--------------------------------------------------------------------------}
  173. {screen setup procedures}
  174.  
  175. procedure BorderColor(NewColor: byte); assembler; {from TechInfoNote TI2644}
  176.   asm
  177.     mov ah, 0Bh
  178.     mov bh, 00h
  179.     mov bl, NewColor
  180.     int 10h
  181.   end;  {BorderColor}
  182.  
  183. procedure Frame(X1,Y1,X2,Y2: Integer);
  184.   var  I : Integer;
  185.   begin
  186.     window(1,1,80,25);
  187.     gotoxy(X1-1,Y1-1);
  188.     write(#201);
  189.     for I := (X1) to (X2) do write(#205);
  190.     write(#187);
  191.     for I := (Y1) to (Y2) do
  192.      begin
  193.         gotoxy(X1-1,I);  write(#186);
  194.         gotoxy(X2+1,I);  write(#186);
  195.       end;
  196.     gotoxy(X1-1,Y2+1);
  197.     write(#200);
  198.     for I := (X1) to (X2) do write(#205);
  199.     write(#188);
  200.   end;  {Frame}
  201.  
  202. procedure DrawScreen;
  203.   begin
  204.     TextMode(C80);                                 {and draw initial screen}
  205.     BorderColor(Blue);
  206.     TextBackground(Blue); TextColor(White); clrscr;
  207.     write(' ReadBPA');
  208.     TextBackground(LightGray); TextColor(Black);
  209.     Frame(2,3,79,23); window(2,3,79,23); clrscr;
  210.   end;  {DrawScreen}
  211.  
  212. procedure DrawViewWindow;
  213.   begin
  214.     window(2,1,80,25); TextBackground(Blue); TextColor(White);
  215.     write(FileName);                                  {display the filename}
  216.     gotoxy(1,25); TextColor(LightGray);
  217.     write('Esc: Exit     F3: New File     ');
  218.     write('Searches: F5: Filename  F6: Keyword  '#17,#196,#217,': Clear');
  219.     window(2,3,79,23); TextBackground(LightGray); TextColor(Black);
  220.     clrscr;
  221.     gotoxy(60,1); writeln('Line Count:',LineCount:5);
  222.   end;  {DrawViewWindow}
  223.  
  224. {--------------------------------------------------------------------------}
  225. {search and display procedures}
  226.  
  227. function BPATop(Index:word):boolean;
  228.   begin                                     {first line of each description}
  229.     BPATop:= copy(BPA[Index]^,1,1) = '[';                  {starts with '['}
  230.   end;
  231.  
  232. function Match(Index:word): boolean;
  233.   begin
  234.     case SearchType of
  235.      F5 : Match:= (pos(SearchSpec,BPA[Index+1]^)=1);
  236.                                            {filename at beginning of line 2}
  237.      F6 : Match:= (pos(SearchSpec,BPA[Index+4]^+BPA[LineIndex+5]^)<>0);
  238.                                           {keyword anywhere in lines 5 or 6}
  239.     else  Match:=True;
  240.     end;  {case}
  241.   end;  {Match}
  242.  
  243. procedure SeekForward(StartPoint:Word);
  244.   var Index:word;
  245.   begin
  246.     for Index:= StartPoint+1 to LineCount do         {search to end of file}
  247.       if BPATop(Index) and Match(Index) then                      {if found}
  248.          begin
  249.            LineIndex:=Index;                               {transfer result}
  250.            break;
  251.          end;
  252.   end;  {SeekForward}
  253.  
  254. procedure SeekReverse(StartPoint:Word);
  255.   var Index:word;
  256.   begin
  257.     for Index:= StartPoint-1 downto 1 do       {search to beginning of file}
  258.       if BPATop(Index) and Match(Index) then                      {if found}
  259.          begin
  260.            LineIndex:=Index;                               {transfer result}
  261.            break;
  262.          end;
  263.   end;  {SeekReverse}
  264.  
  265. procedure Search(InKey:byte);
  266.   const SearchPrompt : array[F5..F6] of string[30]
  267.                      =('Find File...Enter File Name: ',
  268.                        'Start Key Search..Enter Key: ');
  269.   var i:byte;
  270.   begin
  271.     case InKey of
  272.      F5,F6: begin
  273.               gotoxy(3,20);
  274.               write(SearchPrompt[InKey]); clreol;           {display prompt}
  275.               readln(SearchSpec);                          {get search spec}
  276.               if SearchSpec='' then SearchType:=0
  277.               else SearchType:=InKey;
  278.             end;
  279.     else SearchType:=0;                                 {here if InKey = CR}
  280.     end;
  281.  
  282.     if SearchType=0 then                              {no search to be done}
  283.       begin
  284.         gotoxy(1,20); clreol;
  285.         exit;
  286.       end;
  287.  
  288.     for i:=1 to length(SearchSpec) do
  289.       SearchSpec[i]:= upcase(SearchSpec[i]);              {set to uppercase}
  290.     gotoxy(32,20); write(SearchSpec);                           {display it}
  291.     SeekForward(0);                                                   {seek}
  292.     if not Match(LineIndex) then                              {if not found}
  293.       begin
  294.         SearchType:=0;                                        {clear search}
  295.         gotoxy(45,20); write('NOT FOUND');              {and alert operator}
  296.         sound(220); delay(200); nosound;
  297.       end;
  298.   end;  {Search}
  299.  
  300. procedure ShowBPA;
  301.   var i: byte; ThisBPA:boolean;
  302.   begin
  303.     window(2,4,79,24);
  304.     write(BPA[LineIndex]^); clreol;           {write first line this record}
  305.     gotoxy(60,1); writeln('Line Index:',LineIndex:5);
  306.     ThisBPA:=True;               {This is the whole reason for this program}
  307.     for i:=1 to 18 do                       {up to 19 lines per description}
  308.       begin
  309.         if BPATop(LineIndex+i) then                     {if top of next one}
  310.           ThisBPA:=False;                                    {write no more}
  311.         if ThisBPA and (LineIndex+i <= LineCount) then    {and not past end}
  312.           write(BPA[LineIndex+i]^);
  313.         clreol;  writeln;
  314.       end;
  315.   end;  {ShowBPA}
  316.  
  317. procedure NewFile;
  318.   var i:word;
  319.   begin
  320.     repeat
  321.       GetFileName(FileName);
  322.       ReadBPAFile(FileName);    {has operator halt option if unable to read}
  323.     until LineCount>0;
  324.     DrawViewWindow;
  325.     SearchType:=0;
  326.     SeekForward(0);                                             {find first}
  327.     ShowBPA;
  328.   end;  {NewFile}
  329.  
  330. {--------------------------------------------------------------------------}
  331. {key handling procedures}
  332.  
  333. function KeyReady(var InKey:word):boolean;      {True if a key is available}
  334.                {adapted from \bp\examples\utils\prnfltr.pas function GetKey}
  335.   var Key:byte;
  336.   begin
  337.     InKey:=0;
  338.     if KeyPressed then
  339.       begin
  340.         Key:=ord(ReadKey);
  341.         case Key of
  342.          1..127 : InKey:=Key;                                 {standard key}
  343.           0     : begin                                       {extended key}
  344.                     Key:=ord(ReadKey);
  345.                     case Key of
  346.                      1..127 : InKey:=128 + Key;    {new extended key values}
  347.                     end;
  348.                   end;
  349.         end;
  350.       end;
  351.                 {all keys which would normally be reported as extended keys}
  352.                                        {now return 128 + their normal value}
  353.            {except F11 and F12 combinations, which this program doesn't use}
  354.     KeyReady:=InKey<>0;
  355.   end;  {KeyReady}
  356.  
  357. procedure KeyHandler(InKey:byte);
  358.   var SaveLineIndex : word;
  359.   begin
  360.     if SearchType=0 then begin gotoxy(1,20); clreol; end; {clear old prompt}
  361.     SaveLineIndex:=LineIndex;         {used below to decide whether to show}
  362.     case InKey of
  363.      Esc,AltX   : begin ExitFlag:=True; exit; end;                    {exit}
  364.      HomKy      : SeekForward(0);                               {find first}
  365.      EndKy      : SeekReverse(LineCount);                        {find last}
  366.      DnArw,PgDn : SeekForward(LineIndex);                        {find next}
  367.      UpArw,PgUp : SeekReverse(LineIndex);                        {find prev}
  368.      F5,F6,CR   : Search(InKey);                                    {search}
  369.      F3         : NewFile;
  370.     end;
  371.     if LineIndex <> SaveLineIndex then
  372.                   begin
  373.                     ShowBPA;                     {if moved, show new record}
  374.                     if SearchType = 0 then gotoxy(3,20)
  375.                     else gotoxy(45,20);
  376.                     clreol;
  377.                   end
  378.     else case InKey of HomKy,UpArw,PgUp,EndKy,DnArw,PgDn :
  379.                   begin
  380.                     if SearchType = 0 then gotoxy(3,20)
  381.                     else gotoxy(45,20);
  382.                     write('No More');
  383.                    end;
  384.          end;
  385.   end;  {KeyHandler}
  386.  
  387. {--------------------------------------------------------------------------}
  388. {initialization and exit}
  389.  
  390. var
  391.   SaveExit     : pointer;
  392.   SaveTextAttr : byte;
  393.  
  394. {$F+}
  395. procedure ExitReadBPA;
  396.   var i: word;
  397.   begin
  398.     ExitProc:= SaveExit;                     {restore exit procedure address}
  399.     TextMode(C80); TextAttr:=SaveTextAttr; clrscr;{restore screen attributes}
  400.     BorderColor((TextAttr and $70) div 16);                {and border color}
  401.   end;  {ExitReadBPA}
  402. {$F-}
  403.  
  404. procedure Init;
  405.   begin
  406.     SaveExit:= ExitProc;                           {save previous exit proc}
  407.     ExitProc:= @ExitReadBPA;                          {setup exit procedure}
  408.     SaveTextAttr:=TextAttr;              {save text mode and color for exit}
  409.  
  410.     DrawScreen;
  411.   end;  {Init}
  412.  
  413.  
  414. BEGIN
  415.  
  416.   Init;
  417.   NewFile;
  418.  
  419.   repeat
  420.     if KeyReady(InKey) then KeyHandler(InKey);
  421.   until ExitFlag;
  422.  
  423. END.
  424.